home *** CD-ROM | disk | FTP | other *** search
/ FishMarket 1.0 / FishMarket v1.0.iso / fishies / 076-100 / disk_091 / adlrun / adlfuncs.c < prev    next >
C/C++ Source or Header  |  1992-05-06  |  5KB  |  247 lines
  1. #include <stdio.h>
  2.  
  3. #include "adltypes.h"
  4. #include "adlprog.h"
  5. #include "builtins.h"
  6. #include "adlrun.h"
  7.  
  8. dosysfunc( rp )
  9. int16    rp;
  10. {
  11.     int16
  12.     t;
  13.  
  14.     switch( rp ) {
  15.     /* Object routines */
  16.     case _LOC    :
  17.     case _CONT    :
  18.     case _LINK    :
  19.     case _MODIF    : objprop( rp );            break;
  20.     case _LDESC    :
  21.     case _SDESC    :
  22.     case _ACTION    : t = _LDESC;
  23.               objprop( abs( rp - t ) + _LD );    break;
  24.     case _PROP    : assertargs( "$prop", 2 );
  25.               objprop( ARG(2) );        break;
  26.     case _SETP    : setp();                break;
  27.     case _MOVE    : move_obj();            break;
  28.  
  29.     /* Verb routines */
  30.     case _VSET    : vset();            break;
  31.     case _VPROP    : vprop();            break;
  32.  
  33.     /* Arithmetic routines */
  34.     case _PLUS    : assertargs( "$plus", 2 );
  35.               RETVAL = ARG(1) + ARG(2);    break;
  36.     case _MINUS    : assertargs( "$minus", 2 );
  37.               RETVAL = ARG(1) - ARG(2);    break;
  38.     case _TIMES    : assertargs( "$times", 2 );
  39.               RETVAL = ARG(1) * ARG(2);    break;
  40.     case _DIV    : do_div();            break;
  41.     case _MOD    : do_mod();            break;
  42.     case _RAND    : assertargs( "$rand", 1);
  43.               RETVAL = myrand( ARG(1) );    break;
  44.  
  45.     /* Boolean routines */
  46.     case _AND    : do_and();            break;
  47.     case _OR    : do_or();            break;
  48.     case _NOT    : assertargs( "$not", 1 );
  49.               RETVAL = !ARG(1);        break;
  50.     case _YORN    : RETVAL = yesno();        break;
  51.     case _PCT    : assertargs( "$pct", 1 );
  52.               RETVAL = ARG(1) >= myrand(100);    break;
  53.     case _EQ    : assertargs( "$eq", 2 );
  54.               RETVAL = ARG(1) == ARG(2);    break;
  55.     case _NE    : assertargs( "$ne", 2 );
  56.               RETVAL = ARG(1) != ARG(2);    break;
  57.     case _LT    : assertargs( "$lt", 2 );
  58.               RETVAL = ARG(1) <  ARG(2);    break;
  59.     case _GT    : assertargs( "$gt", 2 );
  60.               RETVAL = ARG(1) >  ARG(2);    break;
  61.     case _LE    : assertargs( "$le", 2 );
  62.               RETVAL = ARG(1) <= ARG(2);    break;
  63.     case _GE    : assertargs( "$ge", 2 );
  64.               RETVAL = ARG(1) >= ARG(2);    break;
  65.  
  66.     /* Miscellaneous routines */
  67.     case _SAY    : saystr();            break;
  68.     case _ARG    : do_args();            break;
  69.     case _EXIT    : do_exit();            return;
  70.     case _RETURN    : do_rtrn();            return;
  71.     case _VAL    : do_val();            break;
  72.     case _PHASE    : RETVAL = Phase;        break;
  73.     case _SPEC    : special();            return;
  74.  
  75.     /* Global value routines */
  76.     case _SETG    : setg();            break;
  77.     case _GLOBAL    : assertargs( "$global", 1 );
  78.               varconts( ARG( 1 ) );        break;
  79.     case _VERB    : varconts( _VERB_G );        break;
  80.     case _DOBJ    : varconts( _DOBJ_G );        break;
  81.     case _IOBJ    : varconts( _IOBJ_G );        break;
  82.     case _PREP    : varconts( _PREP_G );        break;
  83.     case _CONJ    : varconts( _CONJ_G );        break;
  84.     case _NUMD    : varconts( _NUMD_G );        break;
  85.  
  86.     /* Transition routines */
  87.     case _SETV    : setverb();            break;
  88.     case _HIT    : hitverb();            break;
  89.     case _MISS    : missverb();            return;
  90.  
  91.     /* String manipulation routines */
  92.     case _EQST    : eqstring();            break;
  93.     case _SUBS    : substring();            break;
  94.     case _LENG    : lengstring();            break;
  95.     case _CAT    : catstring();            break;
  96.     case _POS    : posstring();            break;
  97.     case _READ    : readstring();            break;
  98.     case _SAVESTR    : savestr();            break;
  99.  
  100.     /* Name routines */
  101.     case _NAME    : do_name();            break;
  102.     case _VNAME    : do_vname();            break;
  103.     case _MNAME    : do_mname();            break;
  104.     case _PNAME    : do_pname();            break;
  105.  
  106.     /* Conversion routines */
  107.     case _STR    : do_str();            break;
  108.     case _NUM    : do_num();            break;
  109.     case _ORD    : ordstring();            break;
  110.     case _CHR    : chrstring();            break;
  111.  
  112.     /* Internal structure routines */
  113.     case _SDEM    : setdemon();            break;
  114.     case _DDEM    : deldemon();            break;
  115.     case _SFUS    : setfuse();            break;
  116.     case _DFUS    : assertargs( "$dfus", 2 );
  117.               delfuse( ARG(1), ARG(2) );    break;
  118.     case _INCTURN    : incturn();            break;
  119.     case _TURNS    : retturn();            break;
  120.     case _PROMPT    : doprompt();            break;
  121.     case _ACTOR    : setactor();            break;
  122.     case _DELACT    : assertargs( "$delact", 1 );
  123.               delactor( ARG(1) );        break;
  124.     case _DEFINE    : do_define();            break;
  125.     case _UNDEF    : do_undef();            break;
  126.  
  127.     default        : error( 3 );    /* Illegal builtin */
  128.     }
  129.  
  130.     if( sp <= NUMVAR )    /* A $exit was called by a fuse or something */
  131.     return;
  132.     popip();
  133.     rp = pop();
  134.     sp = bp + 1;
  135.     bp = rp;
  136. }
  137.  
  138. #if DEBUG
  139. assertargs( s, n )
  140. char    *s;
  141. int16    n;
  142. {
  143.     if( n >= RETVAL ) {
  144.     fprintf( stderr, "%s: ", s );
  145.     error( 2 );        /* Too few arguments */
  146.     }
  147. }
  148. #endif
  149.  
  150.  
  151. do_rtrn()
  152. {
  153.     int16
  154.     retval, oldbp;
  155.  
  156.     assertargs( "$return", 1 );
  157.     popip();
  158.     bp = pop();
  159.     retval = pop();
  160.     oldbp = stack[ bp + stack[ bp ] ];
  161.     ip = stack[ bp + stack[ bp ] + 1 ];
  162.     sp = bp;
  163.     push( retval );
  164.     bp = oldbp;
  165. }
  166.  
  167.  
  168. do_exit()
  169. {
  170.     int16
  171.     code;
  172.  
  173.     assertargs( "$exit", 1 );
  174.     code = ARG( 1 );
  175.     if( (code < 0) || (code > 3) )
  176.     error( 28 );
  177.     if( exits[ code ].exit_ok == 0 )
  178.     error( 28 );
  179.     bp = sp = NUMVAR;        /* Trim the stack */
  180.     ip = 0;            /* Clear the IP */
  181.     DO_EXIT( code );
  182. }
  183.  
  184.  
  185. do_val()
  186. {
  187.     assertargs( "$val", 1 );
  188.     RETVAL = ARG( 1 );
  189. }
  190.  
  191.  
  192. getstring( s )
  193. char    *s;
  194. {
  195. #if MULTIPLEX
  196.     fseek( CURRTTY, 0L, 0 );
  197.     if( !fgets( s, SLEN, CURRTTY ) ) {
  198.     /* On EOF, delete the current actor */
  199.     delactor( CURRACT );
  200.     DO_EXIT( 1 );
  201.     }
  202. #else
  203.     if( !gets( s ) ) {        /* EOF detected! */
  204.     head_term();
  205.     exit( -1 );            /* Exit program */
  206.     }
  207. #endif
  208.  
  209.     if( scriptfile != (FILE *)0 )
  210.     fprintf( scriptfile, "%s\n", s );
  211.     numcol = 0;
  212. }
  213.  
  214.  
  215. int16
  216. yesno()
  217. {
  218.     char
  219.     s[ 80 ];
  220.     int16
  221.     i;
  222.  
  223.     getstring( s );
  224.     for( i = 0; (s[ i ] == ' ') || (s[ i ] == '\t'); i++ )
  225.     /* NOTHING */;
  226.     if( (s[ 0 ] == 'y') || (s[ 0 ] == 'Y') )
  227.     return 1;
  228.     else
  229.     return 0;
  230. }
  231.  
  232.  
  233. do_args()
  234. {
  235.     int16
  236.     oldbp;
  237.  
  238.     assertargs( "$arg", 1 );
  239.     oldbp = stack[ sp - 2 ];
  240.     if( ARG( 1 ) )
  241.     RETVAL = stack[ oldbp + ARG( 1 ) ];
  242.     else
  243.     RETVAL = stack[ oldbp ] - 1;
  244. }
  245.  
  246. /*** EOF adlfuncs.c ***/
  247.